home *** CD-ROM | disk | FTP | other *** search
/ Merciful 4 / Merciful - Disc 4.iso / rexx / webmap.pprx < prev    next >
Text File  |  1996-11-04  |  36KB  |  1,338 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996 Cloanto Italia srl */
  2.  
  3. /* $VER: WebMap.pprx 1.0 */
  4.  
  5. /** ENG
  6.  This script loads, saves and edits Internet server-side web maps in the
  7.  "NCSA httpd" format. These maps are used to associate different types
  8.  of actions to the selection of different areas of an image.
  9.  
  10.  The following commands are available:
  11.  
  12.  - Load: a web map file can be selected using the file requester;
  13.    the file objects are appended to the current map objects (if any).
  14.  
  15.  - Add Rectangle: the mouse can be used to define a rectangular object
  16.    in the image. An object data requester is opened when the mouse button
  17.    is released.
  18.  
  19.  - Add Circle: the mouse can be used to define a circular object
  20.    in the image. An object data requester is opened when the mouse button
  21.    is released.
  22.  
  23.  - Add Polygon: the mouse can be used to define a polygon object
  24.    in the image; the polygon can be closed by connecting the line
  25.    to the starting point, or with a click of the right mouse button. An
  26.    object data requester is opened when the mouse button is released
  27.    (polygon points can be freely added or removed in the Parameters field).
  28.  
  29.  - Add Freehand Area: the mouse can be used to define a freehand-polygon
  30.    object in the image, the polygon is automatically closed when the mouse
  31.    button is released. An object data requester is opened when the mouse
  32.    button is released.
  33.  
  34.  - Add Point: the mouse can be used to place a point object in the image.
  35.    An object data requester is opened when the mouse button is released.
  36.  
  37.  - Edit: the edit requester contains a list of the map objects; the
  38.    "View by" gadget can be used to list the items by object data, URL
  39.    or comment. A click on the Show gadget causes the selected object
  40.    to be highlighted in the image. The Edit gadget opens a new requester
  41.    with the selected object data: the Parameters, URL and (optional) Comment
  42.    fields can be edited (this requester is very similar to the one
  43.    which appears after an object definition), and the Delete gadget
  44.    can be used to remove the object from the map.
  45.  
  46.  - Save: this command writes a map file using the current object data.
  47.  
  48.  - Export: this command writes an HTML file (client-side map) using the
  49.    current object data. The file contains a sample inline image definition
  50.    which uses the map. The map definition can however be used by other
  51.    images with the USEMAP attribute. Point objects are not yet supported
  52.    by the HTML specification and therefore cannot be exported.
  53.  
  54.  - Clear: all map objects can be deleted with this command (for example,
  55.    before loading a new map).
  56. */
  57.  
  58. /** DEU
  59.  Dieses Skript dient zum Laden, Speichern und Bearbeiten von Internet
  60.  Web-Maps auf der Serverseite im "NCSA httpd"-Format. Solche Maps
  61.  ermöglichen es, bei der Auswahl bestimmter Bildbereiche unterschiedliche
  62.  Aktionen auszulösen.
  63.  
  64.  Die folgenden Befehle stehen zur Verfügung:
  65.  
  66.  - Laden: Mit Hilfe des Dateiauswahlfensters läßt sich die gewünschte
  67.    Web Map-Datei laden. Dabei werden die Dateiobjekte an die aktuellen
  68.    Map-Objekte (falls vorhanden) angehängt.
  69.  
  70.  - Neues Rechteck: Dient zum Auswählen eines rechteckigen Bereichs
  71.    mit der Maus. Sobald die Maustaste losgelassen wird, öffnet sich ein
  72.    Dialogfenster zur Festlegung der Objektdaten.
  73.  
  74.  - Neuer Kreis: Dient zum Auswählen eines kreisförmigen Bereichs
  75.    mit der Maus. Sobald die Maustaste losgelassen wird, öffnet sich
  76.    ein Dialogfenster zur Festlegung der Objektdaten.
  77.  
  78.  - Neues Polygon: Dient zum Erstellen eines Polygonobjekts,
  79.    welches sich entweder durch Verbinden des Linienendes mit dem
  80.    Anfangspunkt oder durch einen Druck auf die rechte Maustaste
  81.    wieder schließen läßt. Sobald die Maustaste losgelassen wird,
  82.    öffnet sich ein Dialogfenster zur Eingabe der Objektdaten.
  83.  
  84.  - Neues freies Polygon: Dient zum Zeichnen eines freihändig gezeichneten
  85.    Polygonobjekts, welches beim Loslassen der linken Maustaste
  86.    automatisch geschlossen wird. Sobald die Maustaste losgelassen wird,
  87.    öffnet sich ein Dialogfenster zur Eingabe der Objektdaten.
  88.  
  89.  - Neuer Punkt: Dient zum Plazieren eines Punktobjekts auf der
  90.    Bildfläche. Sobald die Maustaste losgelassen wird, öffnet sich ein
  91.    Dialogfenster zur Eingabe der Objektdaten.
  92.  
  93.  - Bearbeiten: Das Edit-Dialogfenster enthält eine Liste der vorhandenen
  94.    Map-Objekte. Unter Verwendung des "Anzeigen als"-Symbols lassen sich
  95.    die einzelnen Elemente wahlweise nach Objektdaten, URL oder
  96.    Kommentar auflisten. Durch Anklicken von "Anzeigen" wird das ausgewählte
  97.    Objekt auf der Bildfläche hervorgehoben dargestellt. Das
  98.    "Bearbeiten"-Symbol dient zum Öffnen eines neuen Dialogfensters mit
  99.    den ausgewählten Objektdaten: Hier läßt sich der Feldinhalt für
  100.    Parameter, URL und einen optionalen Kommentar bearbeiten. Mit Hilfe
  101.    von "Löschen" kann das Objekt aus der aktuellen Map entfernt werden.
  102.    Dieses Dialogfensters ähnelt bezüglich seiner Funktionalität sehr
  103.    stark demjenigen, welches nach einer Objektdefinition geöffnet wird.
  104.  
  105.  - Speichern: Dient zum Speichern einer Map-Datei unter Verwendung
  106.    der aktuellen Objektdaten.
  107.  
  108.  - Löschen: Bewirkt das Löschen aller Map-Objekte (z.B. vor dem Laden
  109.    einer neuen Map).
  110. */
  111.  
  112. IF ARG(1, EXISTS) THEN
  113.     PARSE ARG PPPORT
  114. ELSE
  115.     PPPORT = 'PPAINT'
  116.  
  117. IF ~SHOW('P', PPPORT) THEN DO
  118.     IF EXISTS('PPaint:PPaint') THEN DO
  119.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  120.         DO 30 WHILE ~SHOW('P',PPPORT)
  121.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  122.         END
  123.     END
  124.     ELSE DO
  125.         SAY "Personal Paint could not be loaded."
  126.         EXIT 10
  127.     END
  128. END
  129.  
  130. IF ~SHOW('P', PPPORT) THEN DO
  131.     SAY 'Personal Paint Rexx port could not be opened'
  132.     EXIT 10
  133. END
  134.  
  135. ADDRESS VALUE PPPORT
  136. OPTIONS RESULTS
  137. OPTIONS FAILAT 10000
  138.  
  139. Get 'LANG'
  140. IF RESULT = 1 THEN DO        /* Deutsch */
  141.     global.txt_title_menu  = 'Web Map'
  142.     global.txt_title_load  = 'Web Map laden'
  143.     global.txt_title_edit  = 'Web Map bearbeiten'
  144.     global.txt_title_save  = 'Web Map speichern'
  145.     global.txt_title_exprt = 'Web Map exportieren (HTML)'
  146.     global.txt_title_clear = 'Map löschen'
  147.     global.txt_title_rect  = 'Rechteckdaten'
  148.     global.txt_title_circ  = 'Kreisdaten'
  149.     global.txt_title_poly  = 'Polygondaten'
  150.     global.txt_title_point = 'Punktdaten'
  151.     global.txt_title_def   = 'Standarddaten'
  152.  
  153.     global.txt_menu_load   = 'Laden...'
  154.     global.txt_menu_rect   = 'Neues Rechteck'
  155.     global.txt_menu_circ   = 'Neuer Kreis'
  156.     global.txt_menu_poly   = 'Neues Polygon'
  157.     global.txt_menu_fhand  = 'Neue freies Polygon'
  158.     global.txt_menu_point  = 'Neuer Punkt'
  159.     global.txt_menu_edit   = 'Bearbeiten...'
  160.     global.txt_menu_save   = 'Speichern...'
  161.     global.txt_menu_export = 'Exportieren (HTML)...'
  162.     global.txt_menu_clear  = 'Löschen'
  163.  
  164.     global.txt_gad_quit    = '_Verlassen'
  165.     global.txt_gad_del     = '_Löschen'
  166.     global.txt_gad_view    = 'Ansi_cht als:'
  167.     global.txt_gad_view0   = 'Objekt'
  168.     global.txt_gad_view1   = 'URL'
  169.     global.txt_gad_view2   = 'Kommentar'
  170.     global.txt_gad_edit    = '_Bearbeiten'
  171.     global.txt_gad_show    = 'An_zeigen'
  172.     global.txt_gad_exit    = '_Schließen'
  173.     global.txt_gad_param   = 'Pa_rameter:'
  174.     global.txt_gad_url     = '_URL:'
  175.     global.txt_gad_comm    = 'Ko_mmentar:'
  176.  
  177.     global.txt_err_oldcl   = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
  178.     global.txt_err_load    = 'Map kann nicht geöffnet werden'
  179.     global.txt_err_nomap   = 'Map ist leer'
  180.     global.txt_err_noclear = 'Map ist bereits leer'
  181.     global.txt_err_save    = 'Map kann nicht gespeichert werden'
  182.     global.txt_err_export  = 'Map kann nicht exportiert werden'
  183.     global.txt_err_expoint = 'Punk-Objekte wurden nicht exportiert'
  184.     global.txt_err_badpar  = 'Parameter sind ungültig'
  185.     global.txt_err_nourl   = 'Fehlende URL-Festlegung '
  186.     global.txt_msg_clear   = 'Map wird gelöscht'
  187. END
  188. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  189.     global.txt_title_menu  = 'Web Map'
  190.     global.txt_title_load  = 'Leggere Web Map'
  191.     global.txt_title_edit  = 'Definizione Web Map'
  192.     global.txt_title_save  = 'Scrivere Web Map'
  193.     global.txt_title_exprt = 'Esportare Web Map (HTML)'
  194.     global.txt_title_clear = 'Cancellare Web Map'
  195.     global.txt_title_rect  = 'Dati rettangolo'
  196.     global.txt_title_circ  = 'Dati cerchio'
  197.     global.txt_title_poly  = 'Dati poligono'
  198.     global.txt_title_point = 'Dati punto'
  199.     global.txt_title_def   = 'Dati URL predefinita'
  200.  
  201.     global.txt_menu_load   = 'Leggere...'
  202.     global.txt_menu_rect   = 'Aggiungere rettangolo'
  203.     global.txt_menu_circ   = 'Aggiungere cerchio'
  204.     global.txt_menu_poly   = 'Aggiungere poligono'
  205.     global.txt_menu_fhand  = 'Aggiungere area'
  206.     global.txt_menu_point  = 'Aggiungere punto'
  207.     global.txt_menu_edit   = 'Definire...'
  208.     global.txt_menu_save   = 'Scrivere...'
  209.     global.txt_menu_export = 'Esportare (HTML)...'
  210.     global.txt_menu_clear  = 'Cancellare'
  211.  
  212.     global.txt_gad_quit    = '_Uscire'
  213.     global.txt_gad_del     = '_Cancellare'
  214.     global.txt_gad_view    = '_Elencare per:'
  215.     global.txt_gad_view0   = 'Oggetto'
  216.     global.txt_gad_view1   = 'URL'
  217.     global.txt_gad_view2   = 'Commento'
  218.     global.txt_gad_edit    = '_Definire'
  219.     global.txt_gad_show    = '_Mostrare'
  220.     global.txt_gad_exit    = '_Uscire'
  221.     global.txt_gad_param   = 'Pa_rametri:'
  222.     global.txt_gad_url     = '_URL:'
  223.     global.txt_gad_comm    = 'Co_mmento:'
  224.  
  225.     global.txt_err_oldcl   = 'Questa procedura richiede_una versione più recente_di Personal Paint'
  226.     global.txt_err_load    = 'Il file non può essere aperto'
  227.     global.txt_err_nomap   = 'La mappa è vuota'
  228.     global.txt_err_noclear = 'La mappa è già vuota'
  229.     global.txt_err_save    = 'Errore nella scrittura del file'
  230.     global.txt_err_export  = 'Errore nella scrittura del file'
  231.     global.txt_err_expoint = 'Uno o più punti non sono stati esportati'
  232.     global.txt_err_badpar  = 'Parametri errati'
  233.     global.txt_err_nourl   = 'URL non specificata'
  234.     global.txt_msg_clear   = 'La mappa verrà cancellata'
  235. END
  236. ELSE DO                /* English */
  237.     global.txt_title_menu  = 'Web Map'
  238.     global.txt_title_load  = 'Load Web Map'
  239.     global.txt_title_edit  = 'Edit Web Map'
  240.     global.txt_title_save  = 'Save Web Map'
  241.     global.txt_title_exprt = 'Export Web Map (HTML)'
  242.     global.txt_title_clear = 'Clear Map'
  243.     global.txt_title_rect  = 'Rectangle Data'
  244.     global.txt_title_circ  = 'Circle Data'
  245.     global.txt_title_poly  = 'Polygon Data'
  246.     global.txt_title_point = 'Point Data'
  247.     global.txt_title_def   = 'Default Data'
  248.  
  249.     global.txt_menu_load   = 'Load...'
  250.     global.txt_menu_rect   = 'Add Rectangle'
  251.     global.txt_menu_circ   = 'Add Circle'
  252.     global.txt_menu_poly   = 'Add Polygon'
  253.     global.txt_menu_fhand  = 'Add Freehand Area'
  254.     global.txt_menu_point  = 'Add Point'
  255.     global.txt_menu_edit   = 'Edit...'
  256.     global.txt_menu_save   = 'Save...'
  257.     global.txt_menu_export = 'Export (HTML)...'
  258.     global.txt_menu_clear  = 'Clear'
  259.  
  260.     global.txt_gad_quit    = '_Quit'
  261.     global.txt_gad_del     = '_Delete'
  262.     global.txt_gad_view    = '_View by:'
  263.     global.txt_gad_view0   = 'Object'
  264.     global.txt_gad_view1   = 'URL'
  265.     global.txt_gad_view2   = 'Comment'
  266.     global.txt_gad_edit    = '_Edit'
  267.     global.txt_gad_show    = '_Show'
  268.     global.txt_gad_exit    = 'E_xit'
  269.     global.txt_gad_param   = 'Pa_rameters:'
  270.     global.txt_gad_url     = '_URL:'
  271.     global.txt_gad_comm    = 'Co_mment:'
  272.  
  273.     global.txt_err_oldcl   = 'This script requires a newer_version of Personal Paint'
  274.     global.txt_err_load    = 'The map file cannot be opened'
  275.     global.txt_err_nomap   = 'The map is empty'
  276.     global.txt_err_noclear = 'The map is already empty'
  277.     global.txt_err_save    = 'The map cannot be saved'
  278.     global.txt_err_export  = 'The map cannot be exported'
  279.     global.txt_err_expoint = 'One or more point object were not exported'
  280.     global.txt_err_badpar  = 'Invalid parameters'
  281.     global.txt_err_nourl   = 'URL not specified'
  282.     global.txt_msg_clear   = 'The map will be cleared'
  283. END
  284.  
  285. global.basename = 'T:PP_WebMap_'PRAGMA('ID')'.'
  286. global.last_url = 'http://www.'
  287.  
  288. Version 'REXX'
  289. IF RESULT < 7 THEN DO
  290.     RequestNotify 'PROMPT "'global.txt_err_oldcl'"'
  291.     EXIT 10
  292. END
  293.  
  294. GetCurrentBrush
  295. savebsh = RESULT
  296. SetCurrentBrush 'RECTANGULAR WIDTH 1 HEIGHT 1'
  297.  
  298. GetPen 'FOREGROUND'
  299. savepen = RESULT
  300. Get 'COLORS'
  301. SetPen 'FOREGROUND' RESULT-1
  302.  
  303. Get 'BARS'
  304. savebars = RESULT
  305. Set '"BARS=2"'
  306.  
  307. Get 'GCLIP'
  308. saveclip = RESULT
  309. Set '"GCLIP=0"'
  310.  
  311. DisableTools
  312.  
  313. SIGNAL ON Break_C
  314.  
  315. command = 0
  316. DO FOREVER
  317.     Request '"'global.txt_title_menu'" ',
  318.             '"LIST ACTION = , 10, 'command', 20, 10, ',
  319.             ' ""'global.txt_menu_load'"", ',
  320.             ' ""'global.txt_menu_rect'"", ',
  321.             ' ""'global.txt_menu_circ'"", ',
  322.             ' ""'global.txt_menu_poly'"", ',
  323.             ' ""'global.txt_menu_fhand'"", ',
  324.             ' ""'global.txt_menu_point'"", ',
  325.             ' ""'global.txt_menu_edit'"", ',
  326.             ' ""'global.txt_menu_save'"", ',
  327.             ' ""'global.txt_menu_export'"", ',
  328.             ' ""'global.txt_menu_clear'""  ',
  329.             ' ACTION = PROCEED ',
  330.             ' ACTION = ""'global.txt_gad_quit'"" "'
  331.  
  332.     IF RESULT = 2 THEN    /* Quit */
  333.         LEAVE
  334.     ELSE DO     /* Proceed / Command List */
  335.         command = RESULT.1
  336.         IF      command = 0 THEN CALL LoadMap
  337.         ELSE IF command = 1 THEN CALL AddRectangle
  338.         ELSE IF command = 2 THEN CALL AddCircle
  339.         ELSE IF command = 3 THEN CALL AddPolygon
  340.         ELSE IF command = 4 THEN CALL AddFreehand
  341.         ELSE IF command = 5 THEN CALL AddPoint
  342.         ELSE IF command = 6 THEN CALL EditMap
  343.         ELSE IF command = 7 THEN CALL SaveMap
  344.         ELSE IF command = 8 THEN CALL ExportMap
  345.         ELSE IF command = 9 THEN CALL ClearMap
  346.     END
  347. END
  348.  
  349. CALL Break_C
  350. EXIT 0
  351.  
  352.  
  353.  
  354.  
  355.  
  356. LoadMap: PROCEDURE EXPOSE global.
  357.  
  358.     RequestFile 'TITLE "'global.txt_title_load'"'
  359.     IF RC = 0 THEN DO
  360.         PARSE VALUE RESULT WITH '"' mfilename '"'
  361.         IF OPEN('mfile', mfilename, 'R') THEN DO
  362.             LockGUI
  363.             comment = ''
  364.             DO FOREVER
  365.                 mline = READLN('mfile')
  366.                 IF EOF('mfile') THEN
  367.                     LEAVE
  368.                 mline = STRIP(mline)
  369.                 IF LEFT(mline, 1) = '#' THEN
  370.                     comment = comment STRIP(SUBSTR(mline, 2))
  371.                 ELSE DO
  372.                     PARSE VAR mline obtype url param
  373.                     obtype = TRANSLATE(obtype, XRANGE('a','z'), XRANGE('A', 'Z'))    /* convert to lower case */
  374.                     param = STRIP(TRANSLATE(param, ' ', ','))
  375.                     comment = STRIP(comment)
  376.  
  377.                     IF obtype = 'rect' | ,
  378.                         obtype = 'circle' | ,
  379.                         obtype = 'poly' |,
  380.                         obtype = 'point' THEN DO
  381.  
  382.                         CALL XorObject(obtype, param)
  383.                         CALL AddObject(obtype, 0 '"'param'" "'url'" "'comment'"')
  384.                     END
  385.                     ELSE IF obtype = 'default' THEN DO
  386.                         IF OPEN('obfile', global.basename || 'def', 'W') THEN DO
  387.                             CALL WRITELN('obfile', url)
  388.                             CALL WRITELN('obfile', comment)
  389.                             CALL CLOSE('obfile')
  390.                         END
  391.                     END
  392.                     comment = ''
  393.                 END
  394.             END
  395.             CALL CLOSE('mfile')
  396.             UnlockGUI
  397.         END
  398.         ELSE RequestNotify 'TITLE "'global.txt_title_load'" PROMPT "'global.txt_err_load'"'
  399.     END
  400.  
  401.     RETURN
  402.  
  403.  
  404.  
  405.  
  406. AddRectangle: PROCEDURE EXPOSE global.
  407.  
  408.     SetPointer 'DATA ',
  409.         '"0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,0xA82A,',
  410.         ' 0x0000,0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,',
  411.         ' 0x0000,0x0000,0x0000,0x1FE0,0x1020,0x1020,0x1020,0x1FE0,',
  412.         ' 0x0000,',
  413.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x5454,',
  414.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,',
  415.         ' 0x0000,0x0000,0x0000,0x0000,0x0FD0,0x0810,0x0810,0x0010,',
  416.         ' 0x0FF0" ',
  417.         'HEIGHT 25 OFFSETX -8 OFFSETY -7'
  418.  
  419.     WaitForClick 'DOWN POINT SHOWBRUSH'
  420.     IF RC = 0 THEN DO
  421.         PARSE VAR RESULT button x0 y0 .
  422.         prev_xp = x0
  423.         prev_yp = y0
  424.         drawn = 0
  425.  
  426.         DO FOREVER
  427.             GetMousePosition
  428.             PARSE VAR RESULT xp yp .
  429.  
  430.             IF xp ~= prev_xp | yp ~= prev_yp | ~drawn THEN DO
  431.                 IF drawn THEN
  432.                     Undo
  433.                 DrawRectangle x0 y0 xp yp 'COMPLEMENT'
  434.  
  435.                 prev_xp = xp
  436.                 prev_yp = yp
  437.                 drawn = 1
  438.             END
  439.             ELSE WaitForEvent
  440.  
  441.             GetMouseButton
  442.             IF RESULT ~= button THEN
  443.                 LEAVE
  444.         END
  445.  
  446.         IF x0 > xp THEN DO
  447.             t = x0
  448.             x0 = xp
  449.             xp = t
  450.         END
  451.         IF y0 > yp THEN DO
  452.             t = y0
  453.             y0 = yp
  454.             yp = t
  455.         END
  456.  
  457.         objdata = RequestObject(global.txt_title_rect, 'rect', x0','y0 xp','yp, '', '', 0)
  458.         IF objdata = 'cancel' THEN
  459.             erase_it = 1
  460.         ELSE
  461.             PARSE VAR objdata erase_it .
  462.         IF erase_it THEN
  463.             DrawRectangle x0 y0 xp yp 'COMPLEMENT'
  464.  
  465.         IF objdata ~= 'cancel' THEN DO
  466.             IF erase_it THEN DO
  467.                 PARSE VALUE objdata WITH . '"' param '"' .
  468.                 DrawRectangle param 'COMPLEMENT'
  469.             END
  470.             CALL AddObject('rect', objdata)
  471.         END
  472.     END
  473.     SetPointer
  474.     RETURN
  475.  
  476.  
  477.  
  478.  
  479. AddCircle: PROCEDURE EXPOSE global.
  480.  
  481.     SetPointer 'DATA ',
  482.         '"0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,0xA82A,',
  483.         ' 0x0000,0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,',
  484.         ' 0x0000,0x0000,0x0000,0x0780,0x0840,0x1020,0x1020,0x1020,',
  485.         ' 0x0840,0x0780,',
  486.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x5454,',
  487.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,',
  488.         ' 0x0000,0x0000,0x0000,0x0040,0x0420,0x0810,0x0810,0x0810,',
  489.         ' 0x0420,0x0040" ',
  490.         'HEIGHT 26 OFFSETX -8 OFFSETY -7'
  491.  
  492.     WaitForClick 'DOWN POINT SHOWBRUSH'
  493.     IF RC = 0 THEN DO
  494.         PARSE VAR RESULT button x0 y0 .
  495.         prev_xp = x0
  496.         prev_yp = y0
  497.         drawn = 0
  498.  
  499.         DO FOREVER
  500.             GetMousePosition
  501.             PARSE VAR RESULT xp yp .
  502.  
  503.             IF xp ~= prev_xp | yp ~= prev_yp | ~drawn THEN DO
  504.                 IF drawn THEN
  505.                     Undo
  506.                 GetDistance x0 y0 xp yp 'IMAGERATIO'
  507.                 radius = RESULT
  508.                 DrawCircle x0 y0 'RADIUSX' radius 'COMPLEMENT'
  509.  
  510.                 prev_xp = xp
  511.                 prev_yp = yp
  512.                 drawn = 1
  513.             END
  514.             ELSE WaitForEvent
  515.  
  516.             GetMouseButton
  517.             IF RESULT ~= button THEN
  518.                 LEAVE
  519.         END
  520.  
  521.         objdata = RequestObject(global.txt_title_circ, 'circle', x0','y0 xp','yp, '', '', 0)
  522.         IF objdata = 'cancel' THEN
  523.             erase_it = 1
  524.         ELSE
  525.             PARSE VAR objdata erase_it .
  526.         IF erase_it THEN DO
  527.             DrawCircle x0 y0 'RADIUSX' radius 'COMPLEMENT'
  528.         END
  529.  
  530.         IF objdata ~= 'cancel' THEN DO
  531.             IF erase_it THEN DO
  532.                 PARSE VALUE objdata WITH . '"' x0 y0 xp yp '"' .
  533.                 GetDistance x0 y0 xp yp 'IMAGERATIO'
  534.                 radius = RESULT
  535.                 DrawCircle x0 y0 'RADIUSX' radius 'COMPLEMENT'
  536.             END
  537.             CALL AddObject('circle', objdata)
  538.         END
  539.     END
  540.     SetPointer
  541.     RETURN
  542.  
  543.  
  544.  
  545.  
  546. AddPolygon: PROCEDURE EXPOSE global.
  547.  
  548.     SetPointer 'DATA ',
  549.         '"0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,0xA82A,,',
  550.         ' 0x0000,0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,,',
  551.         ' 0x0000,0x0000,0x0000,0x0400,0x0A80,0x1140,0x0820,0x0440,,',
  552.         ' 0x0280,0x0100,',
  553.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x5454,,',
  554.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,,',
  555.         ' 0x0000,0x0000,0x0000,0x0200,0x0540,0x08A0,0x0410,0x0220,,',
  556.         ' 0x0140,0x0080" ',
  557.         'HEIGHT 26 OFFSETX -8 OFFSETY -7'
  558.  
  559.     WaitForClick 'DOWN POINT SHOWBRUSH'
  560.     IF RC = 0 THEN DO
  561.         PARSE VAR RESULT button x0 y0 .
  562.         prev_xp = x0
  563.         prev_yp = y0
  564.         xs = x0
  565.         ys = y0
  566.         xcoord.0 = x0
  567.         ycoord.0 = y0
  568.         points = 1
  569.         bpressed = 1
  570.         drawn = 0
  571.  
  572.         DO FOREVER
  573.             GetMousePosition
  574.             PARSE VAR RESULT xp yp .
  575.  
  576.             IF xp ~= prev_xp | yp ~= prev_yp | ~drawn THEN DO
  577.                 IF drawn THEN
  578.                     Undo
  579.                 DrawLine xs ys xp yp 'COMPLEMENT NOFIRSTPIXEL'
  580.  
  581.                 prev_xp = xp
  582.                 prev_yp = yp
  583.                 drawn = 1
  584.             END
  585.             ELSE WaitForEvent
  586.  
  587.             GetMouseButton
  588.             IF RESULT = 0 THEN DO
  589.                 IF bpressed THEN DO
  590.                     bpressed = 0
  591.                     dx0 = ABS(prev_xp - x0)
  592.                     dy0 = ABS(prev_yp - y0)
  593.                     IF dx0 < 3 & dy0 < 3 & points > 1 THEN
  594.                         LEAVE
  595.                     IF xs ~= prev_xp | ys ~= prev_yp THEN DO
  596.                         xs = prev_xp
  597.                         ys = prev_yp
  598.                         xcoord.points = xs
  599.                         ycoord.points = ys
  600.                         points = points + 1
  601.                         drawn = 0
  602.                     END
  603.                 END
  604.             END
  605.             ELSE DO
  606.                 IF RESULT ~= button THEN
  607.                     LEAVE
  608.                 bpressed = 1
  609.             END
  610.         END
  611.  
  612.         IF drawn THEN
  613.             Undo
  614.         DrawLine xs ys x0 y0 'COMPLEMENT NOFIRSTPIXEL'
  615.  
  616.         objdata = RequestObject(global.txt_title_poly, 'poly', PointString('xcoord', 'ycoord', ',', points), '', '', 0)
  617.         IF objdata = 'cancel' THEN
  618.             erase_it = 1
  619.         ELSE
  620.             PARSE VAR objdata erase_it .
  621.         IF erase_it THEN
  622.             DrawPolygon '"' PointString('xcoord', 'ycoord', ' ', points) '" COMPLEMENT'
  623.  
  624.         IF objdata ~= 'cancel' THEN DO
  625.             IF erase_it THEN DO
  626.                 PARSE VALUE objdata WITH . '"' param '"' .
  627.                 DrawPolygon '"'param'" COMPLEMENT'
  628.             END
  629.             CALL AddObject('poly', objdata)
  630.         END
  631.     END
  632.     SetPointer
  633.     RETURN
  634.  
  635.  
  636.  
  637.  
  638. AddFreehand: PROCEDURE EXPOSE global.
  639.  
  640.     SetPointer 'DATA ',
  641.         '"0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,0xA82A,',
  642.         ' 0x0000,0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,',
  643.         ' 0x0000,0x0000,0x0000,0x0600,0x0900,0x10C0,0x1020,0x0820,',
  644.         ' 0x0640,0x0180,',
  645.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x5454,',
  646.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,',
  647.         ' 0x0000,0x0000,0x0000,0x0100,0x0480,0x0820,0x0810,0x0410,',
  648.         ' 0x0120,0x0040" ',
  649.         'HEIGHT 26 OFFSETX -8 OFFSETY -7'
  650.  
  651.     WaitForClick 'DOWN POINT SHOWBRUSH'
  652.     IF RC = 0 THEN DO
  653.         PARSE VAR RESULT button x0 y0 .
  654.         prev_xp = x0
  655.         prev_yp = y0
  656.         xcoord.0 = x0
  657.         ycoord.0 = y0
  658.         points = 1
  659.  
  660.         DO FOREVER
  661.             GetMousePosition
  662.             PARSE VAR RESULT xp yp .
  663.  
  664.             IF xp ~= prev_xp | yp ~= prev_yp THEN DO
  665.                 DrawLine prev_xp prev_yp xp yp 'COMPLEMENT NOFIRSTPIXEL'
  666.  
  667.                 xcoord.points = xp
  668.                 ycoord.points = yp
  669.                 points = points + 1
  670.  
  671.                 prev_xp = xp
  672.                 prev_yp = yp
  673.             END
  674.             ELSE WaitForEvent
  675.  
  676.             GetMouseButton
  677.             IF RESULT ~= button THEN
  678.                 LEAVE
  679.         END
  680.         DrawLine prev_xp prev_yp x0 y0 'COMPLEMENT NOFIRSTPIXEL'
  681.  
  682.         objdata = RequestObject(global.txt_title_poly, 'poly', PointString('xcoord', 'ycoord', ',', points), '', '', 0)
  683.         IF objdata = 'cancel' THEN
  684.             erase_it = 1
  685.         ELSE
  686.             PARSE VAR objdata erase_it .
  687.         IF erase_it THEN
  688.             DrawPolygon '"' PointString('xcoord', 'ycoord', ' ', points) '" COMPLEMENT'
  689.  
  690.         IF objdata ~= 'cancel' THEN DO
  691.             IF erase_it THEN DO
  692.                 PARSE VALUE objdata WITH . '"' param '"' .
  693.                 DrawPolygon '"'param'" COMPLEMENT'
  694.             END
  695.             CALL AddObject('poly', objdata)
  696.         END
  697.     END
  698.     SetPointer
  699.     RETURN
  700.  
  701.  
  702.  
  703.  
  704. AddPoint: PROCEDURE EXPOSE global.
  705.  
  706.     SetPointer 'DATA ',
  707.         '"0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,0xA82A,',
  708.         ' 0x0000,0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,',
  709.         ' 0x0000,0x0000,0x0000,0x0000,0x0780,0x0780,0x0780,0x0000,',
  710.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x5454,',
  711.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,',
  712.         ' 0x0000,0x0000,0x0000,0x0000,0x0000,0x0040,0x0040,0x03C0" ',
  713.         'HEIGHT 24 OFFSETX -8 OFFSETY -7'
  714.  
  715.     WaitForClick 'DOWN POINT SHOWBRUSH'
  716.     IF RC = 0 THEN DO
  717.         PARSE VAR RESULT button x0 y0 .
  718.         prev_xp = x0
  719.         prev_yp = y0
  720.  
  721.         SetCurrentBrush 'RECTANGULAR WIDTH 5 HEIGHT 5'
  722.         DisableTools
  723.         PutBrush x0 y0 'COMPLEMENT'
  724.  
  725.         DO FOREVER
  726.             GetMousePosition
  727.             PARSE VAR RESULT xp yp .
  728.  
  729.             IF xp ~= prev_xp | yp ~= prev_yp THEN DO
  730.                 Undo
  731.                 PutBrush xp yp 'COMPLEMENT'
  732.  
  733.                 prev_xp = xp
  734.                 prev_yp = yp
  735.             END
  736.             ELSE WaitForEvent
  737.  
  738.             GetMouseButton
  739.             IF RESULT ~= button THEN
  740.                 LEAVE
  741.         END
  742.  
  743.         objdata = RequestObject(global.txt_title_point, 'point', xp','yp, '', '', 0)
  744.         IF objdata = 'cancel' THEN
  745.             erase_it = 1
  746.         ELSE
  747.             PARSE VAR objdata erase_it .
  748.         IF erase_it THEN
  749.             PutBrush xp yp 'COMPLEMENT'
  750.  
  751.         IF objdata ~= 'cancel' THEN DO
  752.             IF erase_it THEN DO
  753.                 PARSE VALUE objdata WITH . '"' param '"' .
  754.                 PutBrush param 'COMPLEMENT'
  755.             END
  756.             CALL AddObject('point', objdata)
  757.         END
  758.         SetCurrentBrush 'RECTANGULAR WIDTH 1 HEIGHT 1'
  759.         DisableTools
  760.     END
  761.     SetPointer
  762.     RETURN
  763.  
  764.  
  765.  
  766.  
  767. EditMap: PROCEDURE EXPOSE global.
  768.  
  769.     obnum = GetObjectNum()
  770.  
  771.     IF obnum = 0 THEN DO
  772.         RequestNotify 'TITLE "'global.txt_title_edit'" PROMPT "'global.txt_err_nomap'"'
  773.         RETURN
  774.     END
  775.  
  776.     tnum = obnum + 1
  777.     def = obnum
  778.  
  779.     DO ob = 0 FOR obnum
  780.         IF OPEN('obfile', global.basename || ob, 'R') THEN DO
  781.             obtype.ob  = READLN('obfile')
  782.             param.ob   = InsertCommas(READLN('obfile'))
  783.             url.ob     = READLN('obfile')
  784.             comment.ob = READLN('obfile')
  785.             CALL CLOSE('obfile')
  786.         END
  787.     END
  788.     IF OPEN('obfile', global.basename || 'def', 'R') THEN DO
  789.         url.def     = READLN('obfile')
  790.         comment.def = READLN('obfile')
  791.         CALL CLOSE('obfile')
  792.     END
  793.     ELSE DO
  794.         url.def     = ''
  795.         comment.def = ''
  796.     END
  797.     obtype.def = 'default'
  798.     param.def  = ''
  799.  
  800.     action = 0
  801.     selected = 0
  802.     view_by = 0
  803.     IF OPEN('edfile', global.basename || 'edit', 'R') THEN DO
  804.         selected = READLN('edfile')
  805.         view_by = READLN('edfile')
  806.         CALL CLOSE('edfile')
  807.     END
  808.  
  809.     LockGUI
  810.     DO WHILE action ~= 3 & obnum > 0
  811.         req = '"LIST = , 'tnum', 'selected', 26, 8'
  812.         IF view_by = 0 THEN DO
  813.             DO ob = 0 FOR tnum
  814.                 req = req || ', ""' || obtype.ob param.ob '""'
  815.             END
  816.         END
  817.         ELSE IF view_by = 1 THEN DO
  818.             DO ob = 0 FOR tnum
  819.                 IF url.ob ~= '' THEN
  820.                     req = req || ', ""' || url.ob '""'
  821.                 ELSE
  822.                     req = req || ', . '
  823.             END
  824.         END
  825.         ELSE IF view_by = 2 THEN DO
  826.             DO ob = 0 FOR tnum
  827.                 IF comment.ob ~= '' THEN
  828.                     req = req || ', ""' || comment.ob '""'
  829.                 ELSE
  830.                     req = req || ', . '
  831.             END
  832.         END
  833.  
  834.         req = req ||,
  835.             'CYCLE ACTION = ""'global.txt_gad_view'"", 3, 'view_by', ""'global.txt_gad_view0'"", ""'global.txt_gad_view1'"", ""'global.txt_gad_view2'"" ' ||,
  836.             'ACTION = ""'global.txt_gad_edit'"" ' ||,
  837.             'ACTION = ""'global.txt_gad_show'"" ' ||,
  838.             'ACTION = ""'global.txt_gad_exit'"" "'
  839.  
  840.         Request '"'global.txt_title_edit'" RESIZE 'req
  841.         action   = RESULT
  842.         selected = RESULT.1
  843.         view_by  = RESULT.2
  844.  
  845.         IF action = 1 THEN DO    /* Edit */
  846.             IF obtype.selected = 'rect' THEN
  847.                 title = global.txt_title_rect
  848.             ELSE IF obtype.selected = 'circle' THEN
  849.                 title = global.txt_title_circ
  850.             ELSE IF obtype.selected = 'poly' THEN
  851.                 title = global.txt_title_poly
  852.             ELSE IF obtype.selected = 'point' THEN
  853.                 title = global.txt_title_point
  854.             ELSE
  855.                 title = global.txt_title_def
  856.  
  857.             objdata = RequestObject(title, obtype.selected, param.selected, url.selected, comment.selected, 1)
  858.  
  859.             IF objdata = 'delete' THEN DO        /* Delete */
  860.                 IF selected ~= def THEN DO
  861.                     CALL XorObject(obtype.selected, TRANSLATE(param.selected, ' ', ','))
  862.  
  863.                     ADDRESS COMMAND 'Delete >NIL: 'global.basename || selected
  864.  
  865.                     IF selected < obnum THEN DO
  866.                         obmax = tnum - 2
  867.                         DO ob = selected TO obmax
  868.                             nob = ob + 1
  869.                             obtype.ob  = obtype.nob
  870.                             param.ob   = param.nob
  871.                             url.ob     = url.nob
  872.                             comment.ob = comment.nob
  873.                             IF ob < obmax THEN
  874.                                 ADDRESS COMMAND 'Rename >NIL: 'global.basename || nob  global.basename || ob
  875.                         END
  876.                     END
  877.                     obnum = obnum - 1
  878.                     tnum = obnum + 1
  879.                     def = obnum
  880.                     CALL SetObjectNum(obnum)
  881.  
  882.                     IF selected >= obnum & obnum > 0 THEN
  883.                         selected = obnum - 1
  884.                 END
  885.                 ELSE DO    /* default */
  886.                     ADDRESS COMMAND 'Delete >NIL: 'global.basename || 'def'
  887.                     url.def     = ''
  888.                     comment.def = ''
  889.                 END
  890.             END
  891.             ELSE IF objdata ~= 'cancel' THEN DO        /* Proceed */
  892.                 IF selected ~= def THEN DO
  893.                     PARSE VAR objdata new_par .
  894.                     IF new_par THEN
  895.                         CALL XorObject(obtype.selected, TRANSLATE(param.selected, ' ', ','))
  896.  
  897.                     PARSE VALUE objdata WITH . '"' param.selected '" "' url.selected '" "' comment.selected '"' .
  898.                     IF new_par THEN
  899.                         CALL XorObject(obtype.selected, TRANSLATE(param.selected, ' ', ','))
  900.  
  901.                     IF OPEN('obfile', global.basename || selected, 'W') THEN DO
  902.                         CALL WRITELN('obfile', obtype.selected)
  903.                         CALL WRITELN('obfile', TRANSLATE(param.selected, ' ', ','))
  904.                         CALL WRITELN('obfile', url.selected)
  905.                         CALL WRITELN('obfile', comment.selected)
  906.                         CALL CLOSE('obfile')
  907.                     END
  908.                 END
  909.                 ELSE DO    /* default */
  910.                     PARSE VALUE objdata WITH '"' url.selected '" "' comment.selected '"' .
  911.  
  912.                     IF OPEN('sfile', global.basename || 'def', 'W') THEN DO
  913.                         CALL WRITELN('sfile', url.selected)
  914.                         CALL WRITELN('sfile', comment.selected)
  915.                         CALL CLOSE('sfile')
  916.                     END
  917.                 END
  918.             END
  919.         END
  920.         ELSE IF action = 2 & selected ~= def THEN DO        /* Show */
  921.             CALL XorObject(obtype.selected, TRANSLATE(param.selected, ' ', ','))
  922.             times = 5
  923.             DO tm = 1 TO times
  924.                 Wait 'TIME 120'
  925.                 Undo
  926.                 IF tm < times THEN DO
  927.                     Wait 'TIME 120'
  928.                     Redo
  929.                 END
  930.             END
  931.         END
  932.     END
  933.     UnlockGUI
  934.  
  935.     IF OPEN('sfile', global.basename || 'edit', 'W') THEN DO
  936.         CALL WRITELN('sfile', selected)
  937.         CALL WRITELN('sfile', view_by)
  938.         CALL CLOSE('sfile')
  939.     END
  940.  
  941.     RETURN
  942.  
  943.  
  944.  
  945.  
  946. SaveMap: PROCEDURE EXPOSE global.
  947.  
  948.     obnum = GetObjectNum()
  949.  
  950.     IF obnum > 0 THEN DO
  951.         RequestFile 'TITLE "'global.txt_title_save'" SAVEMODE'
  952.         IF RC = 0 THEN DO
  953.             PARSE VALUE RESULT WITH '"' mfilename '"'
  954.             IF OPEN('mfile', mfilename, 'W') THEN DO
  955.                 LockGUI
  956.                 GetImageAttributes 'NAME'
  957.                 CALL WRITELN('mfile', '# Map file for "'RESULT'" ('obnum' objects)')
  958.  
  959.                 DO ob = 0 FOR obnum
  960.                     IF OPEN('obfile', global.basename || ob, 'R') THEN DO
  961.                         obtype  = READLN('obfile')
  962.                         param   = READLN('obfile')
  963.                         url     = READLN('obfile')
  964.                         comment = READLN('obfile')
  965.  
  966.                         CALL WRITELN('mfile', '')
  967.                         IF comment ~= '' THEN
  968.                             CALL WRITELN('mfile', '# 'comment)
  969.                         CALL WRITELN('mfile', obtype url InsertCommas(param))
  970.  
  971.                         CALL CLOSE('obfile')
  972.                     END
  973.                 END
  974.                 IF OPEN('obfile', global.basename || 'def', 'R') THEN DO
  975.                     url = READLN('obfile')
  976.                     comment = READLN('obfile')
  977.                     CALL WRITELN('mfile', '')
  978.                     IF comment ~= '' THEN
  979.                         CALL WRITELN('mfile', '# 'comment)
  980.                     CALL WRITELN('mfile', 'default 'url)
  981.                     CALL CLOSE('obfile')
  982.                 END
  983.                 CALL CLOSE('mfile')
  984.                 UnlockGUI
  985.             END
  986.             ELSE RequestNotify 'TITLE "'global.txt_title_save'" PROMPT "'global.txt_err_save'"'
  987.         END
  988.     END
  989.     ELSE RequestNotify 'TITLE "'global.txt_title_save'" PROMPT "'global.txt_err_nomap'"'
  990.  
  991.     RETURN
  992.  
  993.  
  994.  
  995. ExportMap: PROCEDURE EXPOSE global.
  996.  
  997.     obnum = GetObjectNum()
  998.  
  999.     IF obnum > 0 THEN DO
  1000.         RequestFile 'TITLE "'global.txt_title_exprt'" SAVEMODE'
  1001.         IF RC = 0 THEN DO
  1002.             PARSE VALUE RESULT WITH '"' mfilename '"'
  1003.             IF OPEN('mfile', mfilename, 'W') THEN DO
  1004.                 LockGUI
  1005.                 GetImageAttributes 'NAME'
  1006.                 imgname = RESULT
  1007.                 ppos = INDEX(imgname, '.')
  1008.                 IF ppos > 1 THEN
  1009.                     mapname = LEFT(imgname, ppos - 1)
  1010.                 ELSE
  1011.                     mapname = imgname
  1012.                 point_found = 0
  1013.  
  1014.                 CALL WRITELN('mfile', '<!-- Map file for "'imgname'" ('obnum' objects) -->')
  1015.  
  1016.                 CALL WRITELN('mfile', '0a'X'<H1>Imagemap</H1>')
  1017.                 CALL WRITELN('mfile', '<IMG SRC="'imgname'" USEMAP="#'mapname'">')
  1018.                 CALL WRITELN('mfile', '<MAP NAME="'mapname'">')
  1019.  
  1020.                 DO ob = 0 FOR obnum
  1021.                     IF OPEN('obfile', global.basename || ob, 'R') THEN DO
  1022.                         obtype  = READLN('obfile')
  1023.                         param   = READLN('obfile')
  1024.                         url     = READLN('obfile')
  1025.                         comment = READLN('obfile')
  1026.  
  1027.                         IF obtype = 'point' THEN
  1028.                             point_found = 1
  1029.                         ELSE DO
  1030.                             IF obtype = 'poly' THEN
  1031.                                 obtype = 'polygon'
  1032.  
  1033.                             CALL WRITECH('mfile', '<AREA SHAPE="'obtype'" ')
  1034.  
  1035.                             IF comment ~= '' THEN
  1036.                                 CALL WRITECH('mfile', 'ALT="'comment'" ')
  1037.  
  1038.                             IF obtype = 'circle' THEN DO
  1039.                                 PARSE VAR param x0 y0 x1 y1 .
  1040.                                 GetDistance x0 y0 x1 y1 'IMAGERATIO'
  1041.                                 param = x0 y0 RESULT
  1042.                             END
  1043.  
  1044.                             CALL WRITELN('mfile', 'COORDS="' || TRANSLATE(param, ',', ' ') || '" HREF="'url'">')
  1045.                         END
  1046.                         CALL CLOSE('obfile')
  1047.                     END
  1048.                 END
  1049.                 IF OPEN('obfile', global.basename || 'def', 'R') THEN DO
  1050.                     url = READLN('obfile')
  1051.                     comment = READLN('obfile')
  1052.                     CALL WRITECH('mfile', '<AREA SHAPE="rect" ')
  1053.  
  1054.                     IF comment ~= '' THEN
  1055.                         CALL WRITECH('mfile', 'ALT="'comment'" ')
  1056.  
  1057.                     Get 'IMAGEW'
  1058.                     xmax = RESULT - 1
  1059.                     Get 'IMAGEH'
  1060.                     ymax = RESULT - 1
  1061.  
  1062.                     CALL WRITELN('mfile', 'COORDS="0,0,'xmax','ymax'" HREF="'url'">')
  1063.  
  1064.                     CALL CLOSE('obfile')
  1065.                 END
  1066.                 CALL WRITELN('mfile', '</MAP>')
  1067.                 CALL CLOSE('mfile')
  1068.  
  1069.                 IF point_found THEN
  1070.                     RequestNotify 'TITLE "'global.txt_title_exprt'" PROMPT "'global.txt_err_expoint'"'
  1071.  
  1072.                 UnlockGUI
  1073.             END
  1074.             ELSE RequestNotify 'TITLE "'global.txt_title_exprt'" PROMPT "'global.txt_err_export'"'
  1075.         END
  1076.     END
  1077.     ELSE RequestNotify 'TITLE "'global.txt_title_exprt'" PROMPT "'global.txt_err_nomap'"'
  1078.  
  1079.     RETURN
  1080.  
  1081.  
  1082.  
  1083. ClearMap: PROCEDURE EXPOSE global.
  1084.  
  1085.     IF GetObjectNum() > 0 THEN DO
  1086.         RequestResponse 'TITLE "'global.txt_title_clear'" PROMPT "'global.txt_msg_clear'"'
  1087.         IF RC = 0 THEN
  1088.             CALL Cleanup
  1089.     END
  1090.     ELSE RequestNotify 'TITLE "'global.txt_title_clear'" PROMPT "'global.txt_err_noclear'"'
  1091.  
  1092.     RETURN
  1093.  
  1094.  
  1095.  
  1096.  
  1097. PointString:
  1098.  
  1099.     INTERPRET('PROCEDURE EXPOSE' ARG(1)'.' ARG(2)'.')
  1100.  
  1101.     xname = ARG(1)
  1102.     yname = ARG(2)
  1103.     separ = ARG(3)
  1104.     ptnum = ARG(4)
  1105.  
  1106.     DO pt = 0 FOR ptnum
  1107.         ppoint = VALUE(xname'.'pt) || separ || VALUE(yname'.'pt)
  1108.         IF pt = 0 THEN
  1109.             ppoints = ppoint
  1110.         ELSE
  1111.             ppoints = ppoints ppoint
  1112.     END
  1113.  
  1114.     RETURN ppoints
  1115.  
  1116.  
  1117.  
  1118.  
  1119. InsertCommas: PROCEDURE EXPOSE global.
  1120.  
  1121.     param = ARG(1)
  1122.     wnum = WORDS(param)
  1123.  
  1124.     DO w = 1 TO wnum BY 2
  1125.         point = WORD(param, w) || ',' || WORD(param, w+1)
  1126.         IF w = 1 THEN
  1127.             cparam = point
  1128.         ELSE
  1129.             cparam = cparam point
  1130.     END
  1131.  
  1132.     RETURN cparam
  1133.  
  1134.  
  1135.  
  1136.  
  1137. RequestObject: PROCEDURE EXPOSE global.
  1138.  
  1139.     do_request = 1
  1140.  
  1141.     DO WHILE do_request
  1142.         title   = ARG(1)
  1143.         type    = ARG(2)
  1144.         param   = ARG(3)
  1145.         url     = ARG(4)
  1146.         comment = ARG(5)
  1147.         delgadg = ARG(6)
  1148.  
  1149.         do_request = 0
  1150.         is_def = (type = 'default')
  1151.  
  1152.         IF url = '' & ~is_def THEN
  1153.             url = global.last_url
  1154.  
  1155.         start_url = url
  1156.         start_param = param
  1157.  
  1158.         IF delgadg THEN
  1159.             reqact = 'ACTION = PROCEED ' ||,
  1160.                         'ACTION = ""'global.txt_gad_del'"" ' ||,
  1161.                         'ACTION = CANCEL '
  1162.         ELSE
  1163.             reqact = ''     /* PROCEED CANCEL */
  1164.  
  1165.         IF is_def THEN DO
  1166.             Request '"'CENTER(title, 44)'" RESIZE ',  /* spaces are used to properly size the requester */
  1167.                      '"STRING = ""'global.txt_gad_url'"", 200, ""'url'"" ',
  1168.                      ' STRING = ""'global.txt_gad_comm'"", 200, ""'comment'"" ',
  1169.                         reqact '"'
  1170.             IF RC = 0 & RESULT = 1 THEN DO    /* Proceed */
  1171.                 url     = RESULT.1
  1172.                 comment = RESULT.2
  1173.  
  1174.                 IF url = '' THEN
  1175.                     obj_data = 'delete'
  1176.                 ELSE
  1177.                     obj_data = '"'url'" "'comment'"'
  1178.             END
  1179.             ELSE IF RC = 0 & RESULT = 2 THEN        /* Delete */
  1180.                 obj_data = 'delete'
  1181.             ELSE
  1182.                 obj_data = 'cancel'
  1183.         END
  1184.         ELSE DO
  1185.             Request '"'CENTER(title, 44)'" RESIZE ',  /* spaces are used to properly size the requester */
  1186.                      '"STRING = ""'global.txt_gad_param'"", 1000, ""'param'"" ',
  1187.                      ' STRING = ""'global.txt_gad_url'"", 200, ""'url'"" ',
  1188.                      ' STRING = ""'global.txt_gad_comm'"", 200, ""'comment'"" ',
  1189.                         reqact '"'
  1190.             IF RC = 0 & RESULT = 1 THEN DO    /* Proceed */
  1191.                 param   = RESULT.1
  1192.                 url     = RESULT.2
  1193.                 comment = RESULT.3
  1194.                 newparam = (param ~= start_param)
  1195.  
  1196.                 IF      type = 'rect'   THEN    crdnum = 4
  1197.                 ELSE IF type = 'circle' THEN    crdnum = 4
  1198.                 ELSE IF type = 'point'  THEN    crdnum = 2
  1199.                 ELSE crdnum = 0    /* poly */
  1200.  
  1201.                 param = TRANSLATE(param, ' ', ',')
  1202.                 pnum = WORDS(param)
  1203.  
  1204.                 IF ~DATATYPE(pnum / 2, 'W') THEN
  1205.                     do_request = 1
  1206.                 IF crdnum > 0 & crdnum ~= pnum THEN
  1207.                     do_request = 1
  1208.                 IF ~do_request THEN DO
  1209.                     DO pn = 1 TO pnum
  1210.                         IF ~DATATYPE(WORD(param, pn), 'W') THEN DO
  1211.                             do_request = 1
  1212.                             LEAVE
  1213.                         END
  1214.                     END
  1215.                 END
  1216.                 IF do_request THEN
  1217.                     RequestNotify 'PROMPT "'global.txt_err_badpar'"'
  1218.                 ELSE IF url = '' THEN DO
  1219.                     do_request = 1
  1220.                     RequestNotify 'PROMPT "'global.txt_err_nourl'"'
  1221.                 END
  1222.                 IF ~do_request THEN
  1223.                     obj_data = newparam '"'param'" "'url'" "'comment'"'
  1224.             END
  1225.             ELSE IF RC = 0 & RESULT = 2 THEN        /* Delete */
  1226.                 obj_data = 'delete'
  1227.             ELSE
  1228.                 obj_data = 'cancel'
  1229.         END
  1230.         IF url ~= start_url & url ~= '' THEN
  1231.             global.last_url = url
  1232.     END
  1233.  
  1234.     RETURN obj_data
  1235.  
  1236.  
  1237.  
  1238.  
  1239. GetObjectNum: PROCEDURE EXPOSE global.
  1240.  
  1241.     obnum = 0
  1242.     IF OPEN('obnfile', global.basename || 'num', 'R') THEN DO
  1243.         obnum = READLN('obnfile')
  1244.         CALL CLOSE('obnfile')
  1245.     END
  1246.     RETURN obnum
  1247.  
  1248.  
  1249.  
  1250.  
  1251.  
  1252. SetObjectNum: PROCEDURE EXPOSE global.
  1253.  
  1254.     IF OPEN('obnfile', global.basename || 'num', 'W') THEN DO
  1255.         CALL WRITELN('obnfile', ARG(1))
  1256.         CALL CLOSE('obnfile')
  1257.     END
  1258.     RETURN
  1259.  
  1260.  
  1261.  
  1262.  
  1263. AddObject: PROCEDURE EXPOSE global.
  1264.  
  1265.     PARSE VALUE ARG(2) WITH . '"' param '" "' url '" "' comment '"'
  1266.     obnum = GetObjectNum()
  1267.     IF OPEN('obfile', global.basename || obnum, 'W') THEN DO
  1268.         CALL WRITELN('obfile', ARG(1))
  1269.         CALL WRITELN('obfile', param)
  1270.         CALL WRITELN('obfile', url)
  1271.         CALL WRITELN('obfile', comment)
  1272.         CALL CLOSE('obfile')
  1273.  
  1274.         CALL SetObjectNum(obnum + 1)
  1275.     END
  1276.     RETURN
  1277.  
  1278.  
  1279.  
  1280.  
  1281. XorObject: PROCEDURE EXPOSE global.
  1282.  
  1283.     obtype = ARG(1)
  1284.     param = ARG(2)
  1285.  
  1286.     IF obtype = 'point' THEN DO
  1287.         SetCurrentBrush 'RECTANGULAR WIDTH 5 HEIGHT 5'
  1288.         PutBrush param 'COMPLEMENT'
  1289.         SetCurrentBrush 'RECTANGULAR WIDTH 1 HEIGHT 1'
  1290.         DisableTools
  1291.     END
  1292.     ELSE IF obtype = 'circle' THEN DO
  1293.         PARSE VAR param x0 y0 x1 y1 .
  1294.         GetDistance x0 y0 x1 y1 'IMAGERATIO'
  1295.         DrawCircle x0 y0 'RADIUSX' RESULT 'COMPLEMENT'
  1296.     END
  1297.     ELSE IF obtype = 'rect' THEN
  1298.         DrawRectangle param 'COMPLEMENT'
  1299.  
  1300.     ELSE IF obtype = 'poly' THEN
  1301.         DrawPolygon '"'param'" COMPLEMENT'
  1302.  
  1303.     RETURN
  1304.  
  1305.  
  1306.  
  1307.  
  1308. Cleanup: PROCEDURE EXPOSE global.
  1309.  
  1310.     LockGUI
  1311.     obnum = GetObjectNum()
  1312.  
  1313.     DO ob = 0 FOR obnum
  1314.         IF OPEN('obfile', global.basename || ob, 'R') THEN DO
  1315.             CALL XorObject(READLN('obfile'), READLN('obfile'))
  1316.             CALL CLOSE('obfile')
  1317.         END
  1318.     END
  1319.     ADDRESS COMMAND 'Delete >NIL: 'global.basename'#?'
  1320.     UnlockGUI
  1321.  
  1322.     RETURN
  1323.  
  1324.  
  1325.  
  1326.  
  1327. Break_C:
  1328.  
  1329.     CALL Cleanup
  1330.  
  1331.     SetPen 'FOREGROUND' savepen
  1332.     SetCurrentBrush savebsh
  1333.     Set '"BARS='savebars'"'
  1334.     Set '"GCLIP='saveclip'"'
  1335.     EnableTools
  1336.  
  1337.     RETURN
  1338.